home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
sm.zip
/
BOMB.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1989-08-28
|
12KB
|
295 lines
program bomb;
uses crt;
var
x, y : Integer;
z : Boolean;
procedure s1;
begin
Sound(523); Delay(10); NoSound;
Sound(587); Delay(10); NoSound;
Sound(659); Delay(10); NoSound;
Sound(698); Delay(100); NoSound;
Sound(783); Delay(10); NoSound;
Sound(880); Delay(10); NoSound;
Sound(987); Delay(10); NoSound;
Sound(1046); Delay(500); NoSound;
Delay(100);
Sound(1046); Delay(10); NoSound;
Sound(987); Delay(10); NoSound;
Sound(880); Delay(10); NoSound;
Sound(783); Delay(10); NoSound;
Sound(698); Delay(100); NoSound;
Sound(659); Delay(10); NoSound;
Sound(587); Delay(10); NoSound;
Sound(523); Delay(500); NoSound;
end;
procedure Three;
begin
ClrScr;
TextColor(White+Blink);
WriteLn(' *******************');
WriteLn(' ***');
WriteLn(' ***');
WriteLn(' ***');
WriteLn(' ***');
WriteLn(' ***');
WriteLn(' ***');
WriteLn(' **********');
WriteLn(' ***');
WriteLn(' ***');
WriteLn(' ***');
WriteLn(' ***');
WriteLn(' ***');
WriteLn(' ***');
WriteLn(' ***');
WriteLn(' *******************');
end;
procedure Two;
begin
ClrScr;
TextColor(White+Blink);
WriteLn(' *********** ');
WriteLn(' ** ');
WriteLn(' ** ');
WriteLn(' ** ');
WriteLn(' ** ');
WriteLn(' ** ');
WriteLn(' *** ');
WriteLn(' ** ');
WriteLn(' ** ');
WriteLn(' ** ');
WriteLn(' ** ');
WriteLn(' ** ');
WriteLn(' ** ');
WriteLn(' ** ');
WriteLn(' ************************* ');
end;
procedure One;
begin
ClrScr;
TextColor(White+Blink);
WriteLn(' * ');
WriteLn(' * * * ');
WriteLn(' * * ');
WriteLn(' * ');
WriteLn(' * ');
WriteLn(' * ');
WriteLn(' * ');
WriteLn(' * ');
WriteLn(' * ');
WriteLn(' * ');
WriteLn(' * ');
WriteLn(' * ');
WriteLn(' * ');
WriteLn(' * ');
WriteLn(' ************** ');
end;
procedure D;
begin
ClrScr;
TextColor(Black+Blink);
TextBackGround(White+Blink);
WriteLn('.............................................................................');
WriteLn('.............................................................................');
WriteLn('.............................................................................');
WriteLn('.............................................................................');
WriteLn('.............................................................................');
WriteLn('.............................................................................');
WriteLn('.............................................................................');
WriteLn('.............................................................................');
WriteLn('.............................................................................');
WriteLn('.............................................................................');
WriteLn('.............................................................................');
WriteLn('.............................................................................');
WriteLn('.............................................................................');
WriteLn('.............................................................................');
WriteLn('..................BOOM.......................................................');
WriteLn('.............................................................................');
WriteLn('.............................................................................');
WriteLn('.............................................................................');
WriteLn('.............................................................................');
WriteLn('.............................................................................');
WriteLn('.............................................................................');
WriteLn('.............................................................................');
WriteLn('.............................................................................');
WriteLn('.............................................................................');
WriteLn('.............................................................................');
WriteLn('.............................................................................');
end;
procedure K;
begin
Sound(1150); Delay(3); NoSound;
Sound(1119); Delay(3); NoSound;
end;
procedure Ex;
begin
Delay(100);
z := false;
x := 10;
repeat
y := x+10; x := y;
Sound(y); Delay(10); NoSound;
if y >= 4000 then z := true;
until z;
Sound(19); Delay (50); Sound(2000); Delay(50);
Sound(29); Delay (40); Sound(1800); Delay(40);
Sound(39); Delay (30); Sound(1600); Delay(30);
Sound(49); Delay (20); Sound(1400); Delay(20);
Sound(59); Delay (10); Sound(1200); Delay(10);
Sound(69); Delay (20); Sound(1000); Delay(20);
Sound(79); Delay (30); Sound(900); Delay(30);
Sound(89); Delay (40); Sound(800); Delay(40);
Sound(100); Delay(50); Sound(700); Delay(50); NoSound;
end;
procedure Taps;
begin
Sound(523); Delay(250); NoSound;
Sound(523); Delay(250); NoSound;
Sound(698); Delay(750); NoSound;
Sound(523); Delay(250); NoSound;
Sound(698); Delay(250); NoSound;
Sound(880); Delay(750); NoSound;
Sound(523); Delay(250); NoSound;
Sound(698); Delay(250); NoSound;
Sound(880); Delay(500); NoSound;
Sound(523); Delay(250); NoSound;
Sound(698); Delay(250); NoSound;
Sound(880); Delay(500); NoSound;
Sound(523); Delay(250); NoSound;
Sound(698); Delay(250); NoSound;
Sound(880); Delay(500); NoSound;
Sound(698); Delay(250); NoSound;
Sound(880); Delay(250); NoSound;
Sound(1046); Delay(1000); NoSound;
Sound(880); Delay(250); NoSound;
Sound(698); Delay(250); NoSound;
Sound(523); Delay(1000); NoSound;
Sound(523); Delay(500); NoSound;
Sound(523); Delay(250); NoSound;
Sound(698); Delay(2000); NoSound;
end;
procedure s2;
begin
Sound(523); Delay(100); NoSound;
Sound(587); Delay(100); NoSound;
Sound(659); Delay(100); NoSound;
Sound(698); Delay(100); NoSound;
Sound(783); Delay(100); NoSound;
Sound(880); Delay(100); NoSound;
Sound(987); Delay(100); NoSound;
Sound(1110); Delay(100); NoSound;
Sound(1182); Delay(100); NoSound;
Sound(1221); Delay(100); NoSound;
Sound(1306); Delay(100); NoSound;
Sound(1403); Delay(100); NoSound;
Sound(1510); Delay(100); NoSound;
Sound(1617); Delay(100); NoSound;
Sound(1787); Delay(100); NoSound;
Sound(1893); Delay(100); NoSound;
Sound(1987); Delay(100); NoSound;
Sound(2050); Delay(400); NoSound;
Delay(100);
Sound(2550); Delay(400); NoSound;
Delay(100);
Sound(2050); Delay(400); NoSound;
Delay(100);
Sound(2550); Delay(400); NoSound;
Delay(100);
Sound(2050); Delay(400); NoSound;
Delay(100);
Sound(2550); Delay(400); NoSound;
Delay(100);
Sound(2050); Delay(400); NoSound;
end;
begin {main}
TextBackGround(Black);
ClrScr;
HighVideo;
WriteLn;
WriteLn;
WriteLn('You toy with');
TextColor(Blink+Red);
WriteLn;
WriteLn(' DEATH...');
WriteLn;
WriteLn;
TextColor(Yellow);
WriteLn(' *********** NOTE ************');
WriteLn;
TextColor(LightBlue);
WriteLn('This computer has a nucluar bomb inside of it, that will explode');
WriteLn('in several seconds, minutes, days, weeks, months, or maybe years???');
Delay(4000);
Taps;
WriteLn;
TextColor(Cyan);
Delay(5000);
WriteLn(' Arming Bomb......');
Delay(500);
Sound(587); Delay(150); NoSound;
Sound(587); Delay(150); NoSound;
Sound(587); Delay(150); NoSound;
Sound(587); Delay(200); NoSound;
WriteLn;
Delay(5000);
WriteLn(' Setting Countdown....');
Delay(500);
x:=1;
for x:=1 to 7 do begin
Sound(500); delay(200);
Sound(700); Delay(300); NoSound;
end;
Delay(5000);
WriteLn;
WriteLn(' Activating Counter...');
Delay(500);
s2;
Delay(5000);
WriteLn;
WriteLn(' Final Countdown....');
WriteLn(' Your Dead....');
Sound(19); Delay(3000); NoSound;
Three; s1; s1; s1; Delay(1000);
Two; s1; s1; Delay(1000);
One; s1; Delay(1000);
TextColor(White);
ClrScr;WriteLn;WriteLn;WriteLn(' BYE...');
Ex;D;
repeat
K;
until KeyPressed;
textcolor(white);
textbackground(black);
ClrScr;
HighVideo;
WriteLn;
WriteLn;
WriteLn;
WriteLn(' The Bomb');
WriteLn;
WriteLn(' was written by Daniel Bedinger');
WriteLn;
WriteLn(' with special thanks to:');
WriteLn(' D. Ginskey');
WriteLn(' O. Wenger');
WriteLn(' R. Blue');
WriteLn(' Mr. Reames');
WriteLn;
NormVideo;
WriteLn('Dedicated to Alex, a caring friend. Here''s to The Best Summer ever! ');
WriteLn;
WriteLn;
LowVideo;
WriteLn('--------------------------------------NOTE-------------------------------------');
WriteLn;
WriteLn(' You are encouraged to Nuke friends with this');
WriteLn(' bomb on the conditions that the program is not');
WriteLn(' modified, and that no fee or consideration is charged.');
writeln;
writeln;
end. {main end}